home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib15.dsk / NIBBLE PROGRAMMER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  434 lines
  1. 10  REM  **********************
  2. 11  REM  * NIBBLE PROGRAMMER  *
  3. 12  REM  * BY PAUL M. HYMAN   *
  4. 13  REM  * COPYRIGHT (C) 1983 *
  5. 14  REM  * BY MICROSPARC, INC *
  6. 15  REM  * LINCOLN, MA. 01773 *
  7. 16  REM  **********************
  8. 100  HOME 
  9. 105  HIMEM: 37799
  10. 110 ER = 0
  11. 115  POKE 222,0: POKE 216,0
  12. 120  ONERR  GOTO 810
  13. 130  REM  CONSTANT 1
  14. 140 C1 = 1
  15. 200  HTAB 12: PRINT "NIBBLE  PROGRAMMER": PRINT : PRINT "** COPYRIGHT 1983 BY MICROSPARC, INC. **"
  16. 500 D$ =  CHR$(4)
  17. 502  PRINT D$;"OPEN   STB.P1.TMP"
  18. 504  PRINT D$;"DELETE STB.P1.TMP"
  19. 506  PRINT D$;"OPEN   STB.P2.TMP"
  20. 508  PRINT D$;"DELETE STB.P2.TMP"
  21. 510  PRINT D$;"BLOAD NL.BIN"
  22. 600  VTAB 20
  23. 610  HOME 
  24. 700  INPUT "INPUT FILE-";FF$
  25. 800  PRINT D$;"OPEN ";FF$
  26. 805  GOTO 2700
  27. 810  REM  ***** ERROR ROUTINE
  28. 820 X =  PEEK(222)
  29. 830  IF X = 5 GOTO 900
  30. 840  PRINT D$;"CLOSE"
  31. 850  PRINT "APPLESOFT/DOS ERROR ";X;" AT LINE "; PEEK(218) + PEEK(219) *256
  32. 860  END 
  33. 900  PRINT D$;"CLOSE ";FF$
  34. 910  INPUT "MORE FILES? (Y/N) ";X$
  35. 920  IF X$ = "N"  THEN  PRINT "YOU SHOULD PUT A QUIT AT THE END OF THE LAST FILE": GOTO 7710
  36. 940  INPUT "FILE NAME - ";FF$
  37. 950  PRINT D$;"OPEN";FF$
  38. 960  GOTO 6800
  39. 1100  REM  *** SUBR TO WRITE TO FILE ****
  40. 1200  REM 
  41. 1300  PRINT D$;"WRITE STB.P1.TMP"
  42. 1400  PRINT LN;GG$
  43. 1500  PRINT D$
  44. 1700 LN = LN +10
  45. 1800  RETURN 
  46. 2700  PRINT D$;"OPEN STB.P1.TMP"
  47. 3000  REM  THE 4 DIM'S ARE THE SYMBOL TABLE
  48. 3100  REM  NUMBER OF LABELS
  49. 3200 NL = 100
  50. 3300  REM  NAME FIELD
  51. 3400  DIM L$(NL)
  52. 3500  REM  LINE#
  53. 3600  DIM LI%(NL)
  54. 4100  REM  LABLE TABLE INDEX
  55. 4200 LX = 0
  56. 4300 LN = 10
  57. 4400  REM  WHILE STACK
  58. 4500  DIM WS%(10)
  59. 4600  REM  WHILE LABLE STACK
  60. 4700  DIM WL$(10)
  61. 4800  REM  INIT WHILE STACK PTR
  62. 4900 WP =  -1
  63. 5000  REM  INTERNAL LABEL TABLE
  64. 5010  DIM IL%(200)
  65. 5100  REM  LOOP STACK
  66. 5200  DIM LS%(10)
  67. 5300  DIM LOOPLABELSTACK
  68. 5400  DIM LL$(10)
  69. 5500  REM  INIT LOOP STACK PTR
  70. 5600 LP =  -1
  71. 5700  REM  INITIAL LABEL NUMBER
  72. 5800 L1 = 0
  73. 5900  REM  *** THE IF STACK
  74. 6000  DIM I1$(10)
  75. 6100  REM  THE IF-SEG STACK
  76. 6200  DIM I2$(10)
  77. 6300  REM  IP IS PTR TO IF STACK
  78. 6400 IP =  -1
  79. 6500  REM  IQ IS PTR TO IF-SEG STACK
  80. 6600 IQ =  -1
  81. 6800 A$ = ""
  82. 6900  PRINT D$;"READ ";FF$
  83. 6910 X =  PEEK(49385)
  84. 7000  POKE 37800,1
  85. 7010  CALL 37802,A$
  86. 7020  IF  LEN(A$) = 0 GOTO 7010
  87. 7030  IF  ASC(A$) = 13 GOTO 7010
  88. 7100 AL$ =  LEFT$(A$,1)
  89. 7200  IF AL$ = "*" GOTO 6800
  90. 7300  IF AL$ > = "0"  AND AL$ < = "9"  THEN  FLASH : PRINT "LINE NUMBERS NOT ALLOWED": NORMAL :ER = ER +1: GOTO 6800
  91. 7500 X =  PEEK(37801)
  92. 7510  IF X = 0 GOTO 24100
  93. 7520  ON X GOTO 15700,16900,17700,19100,18400,19610,23210,21000,22405,7710,23930,8700,11410,11410
  94. 7700  STOP 
  95. 7710 GG$ = "END"
  96. 7720  GOSUB 1300
  97. 7730  PRINT D$;"WRITE STB.P1.TMP"
  98. 7740  PRINT "QUIT"
  99. 7800  GOSUB 26300
  100. 8000  PRINT D$;"CLOSE STB.P1.TMP"
  101. 8100  PRINT D$;"CLOSE ";FF$
  102. 8120  IF ER = 0 GOTO 27600
  103. 8130  PRINT ER;" ERRORS DETECTED"
  104. 8140  PRINT D$;"DELETE STB.P1.TMP"
  105. 8150  END 
  106. 8300  REM 
  107. 8400  REM  ******* LABEL *****
  108. 8500  REM 
  109. 8700 LA =  LEN(A$)
  110. 8900 A$ =  RIGHT$(A$,LA -1)
  111. 8910 SF$ = A$
  112. 8920  GOSUB 13900
  113. 9000  GOSUB 9300
  114. 9100  GOTO 6800
  115. 9200  REM 
  116. 9300  REM  **** LABEL DEF. SUBR *****
  117. 9310  IF  LEFT$(A$,1) = "." GOTO 11110
  118. 9400  IF LX = 0 GOTO 10700
  119. 9500  FOR I -0 TO LX -1
  120. 9600  IF L$(I) < >A$ GOTO 10400
  121. 9800  PRINT L$(I);"---> DOUBLE DEFINITION"
  122. 9810 ER = ER +1
  123. 9900 I = 1000
  124. 10400  NEXT 
  125. 10500  IF I = 1001  THEN  RETURN : REM  DBL DEF ERR
  126. 10700 L$(LX) = A$
  127. 10800 LI%(LX) = LN
  128. 10900 LX = LX +1
  129. 11100  RETURN 
  130. 11110 A$ =  RIGHT$(A$, LEN(A$) -1)
  131. 11120 IL%( VAL(A$)) = LN
  132. 11130  RETURN 
  133. 11200  REM  *****  GOTO  ****
  134. 11300  REM 
  135. 11410  GOSUB 11800
  136. 11420 GG$ = A$
  137. 11500  GOSUB 1200
  138. 11600  GOTO 6800
  139. 11700  REM  ** SUBR TO PROC GOTOS **
  140. 11800  REM 
  141. 11810 LM = 0
  142. 11830 SF$ = "GOTO"
  143. 11900  REM  SEARCH LINE FOR GOTO
  144. 12000  GOSUB 24600
  145. 12100  REM  LM=0 MEANS NO GOTO
  146. 12200  IF LM < >0 GOTO 12400
  147. 12210 SF$ = "GOSUB"
  148. 12220  GOSUB 24600
  149. 12230  IF LM = 0  THEN  RETURN 
  150. 12400 LM = LM +3
  151. 12500  REM  EXTRACT LABEL AFTER GOTO
  152. 12600 GL$ =  RIGHT$(A$,LA -LM)
  153. 12700 SF$ = GL$
  154. 12800  GOSUB 13800
  155. 13700  RETURN 
  156. 13800  REM  ****** SUBR TO CHECK LABEL VALIDITY ***
  157. 13900  IF  LEFT$(SF$,1) > = "A"  AND  LEFT$(SF$,1) < = "Z"  THEN  RETURN 
  158. 14000 ER = ER +1
  159. 14100 FLASG: PRINT SF$;"-ILLEGAL LABEL": NORMAL 
  160. 14200  RETURN 
  161. 15400  REM 
  162. 15500  REM  ****** WHILE *******
  163. 15600  REM 
  164. 15700 R$ =  RIGHT$(A$, LEN(A$) -5)
  165. 15800 GG$ = "IF" +R$ +"GOTO" + STR$(LN +20)
  166. 15900  GOSUB 1200
  167. 16000 A$ = "GOTO." + STR$(L1)
  168. 16100 GG$ = A$: GOSUB 1200
  169. 16200 WP = WP +1
  170. 16300 WS%(WP) = LN -20
  171. 16400 WL$(WP) = "." + STR$(L1)
  172. 16500 L1 = L1 +1
  173. 16600  GOTO 6800
  174. 16800  REM  ************ ENDWHILE ********
  175. 16900  IF WP > = 0 GOTO 16990
  176. 16910  FLASH 
  177. 16920  PRINT "NO MATCHING WHILE STATEMENT"
  178. 16930  NORMAL 
  179. 16940 ER = ER +1
  180. 16950  GOTO 6800
  181. 16990 GG$ = "GOTO" + STR$(WS%(WP))
  182. 17000  GOSUB 1200
  183. 17100 A$ = WL$(WP)
  184. 17200 WP = WP -1
  185. 17300  REM  GOTO LABEL DEF ROUTINE
  186. 17400  GOSUB 9300
  187. 17410  GOTO 6800
  188. 17600  REM  ********* LOOP ***********
  189. 17700 LP = LP +1
  190. 17800 LS%(LP) = LN
  191. 17900 LL$(LP) = "." + STR$(L1)
  192. 17910 L1 = L1 +1
  193. 18000 LM = LM +1
  194. 18100  GOTO 6800
  195. 18300  REM  *********** ENDLOOP ********
  196. 18400  IF LP > = 0 GOTO 18490
  197. 18410  FLASH : PRINT "NO MATCHING LOOP"
  198. 18420  NORMAL 
  199. 18430 ER = ER +1
  200. 18440  GOTO 6800
  201. 18490 GG$ = "GOTO" + STR$(LS%(LP))
  202. 18500  GOSUB 1200
  203. 18600 A$ = LL$(LP)
  204. 18700 LP = LP -1
  205. 18800  GOSUB 9300
  206. 18810  GOTO 6800
  207. 19000  REM  ************ EXIT LOOP ******
  208. 19100 R$ =  RIGHT$(A$, LEN(A$) -8)
  209. 19110  IF LP > = 0 GOTO 19200
  210. 19120  FLASH 
  211. 19130  PRINT "NO MATCHING LOOP"
  212. 19140  NORMAL 
  213. 19150 ER = ER +1
  214. 19160  GOTO 6800
  215. 19200 A$ = R$ +"GOTO" +LL$(LP)
  216. 19300 GG$ = A$: GOSUB 1200
  217. 19400  GOTO 6800
  218. 19600  REM  ********* IF *********
  219. 19610 SF$ = "THEN"
  220. 19620  GOSUB 24600
  221. 19625  REM  IF "THEN" EXISTS, NOTHING CAN FOLLOW IT
  222. 19630  IF LM =  LEN(A$) -3 GOTO 19700
  223. 19635  IF LM >0 GOTO 19680
  224. 19637  REM  NO GOTO ALLOWED HERE
  225. 19640 SF$ = "GOTO"
  226. 19650  GOSUB 24600
  227. 19660  IF LM = 0 GOTO 19700
  228. 19680  FLASH : PRINT "ILLEGAL IF STATEMENT":ER = ER +1: NORMAL 
  229. 19690  PRINT ".......";SF$;" AT CHAR ";LM
  230. 19700 GG$ = A$ +"GOTO" + STR$(LN +20)
  231. 19800  GOSUB 1200
  232. 19900 IQ = IQ +1
  233. 20000 IP = IP +1
  234. 20100 I1$(IP) = "." + STR$(L1)
  235. 20200 L1 = L1 +1
  236. 20300 I2$(IQ) = "." + STR$(L1)
  237. 20400 L1 = L1 +1
  238. 20500 A$ = "GOTO" +I2$(IQ)
  239. 20600 GG$ = A$: GOSUB 1200
  240. 20700  GOTO 6800
  241. 20900  REM  ********* ELSE IF *******
  242. 21000 X$ = A$
  243. 21005  IF IP <0  OR IQ <0 GOTO 23520
  244. 21010 A$ = "GOTO" +I1$(IP)
  245. 21020 GG$ = A$: GOSUB 1200
  246. 21100 A$ = I2$(IQ)
  247. 21200 IQ = IQ -1
  248. 21300  REM  DEFINE LABEL
  249. 21400  GOSUB 9300
  250. 21500 GG$ =  RIGHT$(X$, LEN(X$) -4) +"GOTO" + STR$(LN +20)
  251. 21600  GOSUB 1200
  252. 21700 IQ = IQ +1
  253. 21800 I2$(IQ) = "." + STR$(L1)
  254. 21900 L1 = L1 +1
  255. 22000 A$ = "GOTO" +I2$(IQ)
  256. 22100 GG$ = A$: GOSUB 1200
  257. 22200  GOTO 6800
  258. 22400  REM  ****** ELSE *****
  259. 22405  IF IP <0  OR IQ <0 GOTO 23520
  260. 22410 A$ = "GOTO" +I1$(IP)
  261. 22420 GG$ = A$: GOSUB 1200
  262. 22500 A$ = I2$(IQ)
  263. 22600  REM  PUT DUMMY LABL ON STACK FOR ENDIF
  264. 22700 I2$(IQ) = "." + STR$(L1)
  265. 22800 L1 = L1 +1
  266. 22900  GOSUB 9300
  267. 23000  GOTO 6800
  268. 23200  REM  ******* ENDIF  *****
  269. 23210  IF IQ <0 GOTO 23520
  270. 23300 A$ = I2$(IQ)
  271. 23400 IQ = IQ -1
  272. 23500  GOSUB 9300
  273. 23510  IF IP > = 0 GOTO 23600
  274. 23520  FLASH : PRINT "NO MATCHING IF STATEMENT": NORMAL 
  275. 23530 ER = ER +1
  276. 23540  GOTO 6800
  277. 23600 A$ = I1$(IP)
  278. 23700 IP = IP -1
  279. 23800  GOSUB 9300
  280. 23900  GOTO 6800
  281. 23920  REM  ************ ON ***********
  282. 23930  IF  MID$ (A$,3,2) = "ERR" GOTO 24040
  283. 23940 SF$ = "GOTO"
  284. 23950  GOSUB 24600
  285. 23960  IF LM >0  THEN J = LM +4: GOTO 23990
  286. 23970 SF$ = "GOSUB": GOSUB 23600
  287. 23980  IF LM >0  THEN J = LM +5: GOTO 23990
  288. 23985  FLASH : PRINT "ILLEGAL ON STMNT":ER = ER +1: NORMAL : GOTO 6800
  289. 23990  GOSUB 26210
  290. 24000  GOSUB 13800
  291. 24010  IF LL = 0 GOTO 23990
  292. 24015 GG$ = A$
  293. 24020  GOSUB 1200
  294. 24030  GOTO 6800
  295. 24035  REM  ******* ONERR *******
  296. 24040  GOSUB 11700
  297. 24050  GOSUB 1200
  298. 24060  GOTO 6800
  299. 24070  REM  ******* STANDARD BASIC LINE *******
  300. 24100 GG$ = A$
  301. 24200  GOSUB 1200
  302. 24300  GOTO 6800
  303. 24400  REM  *****************
  304. 24500  REM        SUB TO SEARCH FOR SF$ IN A$
  305. 24600 LS =  LEN(SF$)
  306. 24700 LM = 1
  307. 24800 LA =  LEN(A$)
  308. 24805  REM  CHECK FOR QUOTE
  309. 24810  IF  MID$ (A$,LM,1) < > CHR$(34) GOTO 24900
  310. 24820  REM  SCAN FOR MATCHING QUOTE
  311. 24830 LM = LM +C1
  312. 24860  IF  MID$ (A$,LM,C1) < > CHR$(34) GOTO 24830
  313. 24870 LM = LM +1
  314. 24900  IF  MID$ (A$,LM,LS) = SF$ GOTO 25300
  315. 25000 LM = LM +1
  316. 25100  IF LM <LA -LS GOTO 24810
  317. 25200 LM = 0
  318. 25300  RETURN 
  319. 25400  REM  ************
  320. 25500  REM   **SUBR TO SEARCH LABLE TABLE
  321. 25600  IF  LEFT$(SF$,1) < >"." GOTO 25700
  322. 25610 SF$ =  RIGHT$(SF$, LEN(SF$) -1)
  323. 25620 IZ = IL%( VAL(SF$))
  324. 25630  RETURN 
  325. 25700  IF LX = 0  THEN IZ =  -1: RETURN 
  326. 25800 I =  -1
  327. 25900  FOR D = 0 TO 1
  328. 26000 I = I +1
  329. 26010 D = L$(I) = SF$  OR I = LX
  330. 26100  NEXT 
  331. 26110 IZ = I
  332. 26120  IF I = LX  THEN IZ =  -1
  333. 26130  IF IZ < > -1  THEN IZ = LI%(IZ)
  334. 26200  RETURN 
  335. 26210  REM  ****** SUBR TO EXTRACT ON...GOTO LABELS
  336. 26220  REM  **** J POINTS TO LABEL
  337. 26230 LB$ = ""
  338. 26240 LL = 0
  339. 26250  IF J > LEN(A$)  THEN LL = 1: RETURN 
  340. 26260 X$ =  MID$ (A$,J,1)
  341. 26270  IF X$ = ","  THEN J = J +1: RETURN 
  342. 26280 LB$ = LB$ +X$
  343. 26290 J = J +1: GOTO 26250
  344. 26300  PRINT D$
  345. 26400  PRINT "NUMBER OF LABELS=";LX
  346. 27000  IF WP =  -1 GOTO 27410
  347. 27100  FOR I = 0 TO WP -1
  348. 27190  FLASH 
  349. 27200  PRINT "UNTERMINATED WHILE AT STMT ";
  350. 27300  PRINT WS%(I)
  351. 27310 ER = ER +1
  352. 27320  NORMAL 
  353. 27400  NEXT 
  354. 27410  IF LP <0 GOTO 27420
  355. 27415  FLASH : PRINT LP +1;"UNTERMINATED LOOP STATEMENT(S)":ER = ER +1
  356. 27420  IF IP <0  AND IQ <0 GOTO 27430
  357. 27425  FLASH : PRINT "UNTERMINATED IF STATEMENT":ER = ER +1
  358. 27430  NORMAL 
  359. 27440  PRINT "------------- END PASS 1 ------------"
  360. 27500  RETURN 
  361. 27600  PRINT D$;"OPEN STB.P2.TMP"
  362. 27700  PRINT D$;"OPEN STB.P1.TMP"
  363. 27800  PRINT D$;"WRITE STB.P2.TMP"
  364. 27900  PRINT "NEW"
  365. 28000  PRINT D$;"READ STB.P1.TMP"
  366. 28010 X =  PEEK(49385)
  367. 28100  POKE 37800,0
  368. 28110  CALL 37802,A$
  369. 28200  IF  PEEK(37801) < >10 GOTO 29000
  370. 28210  IF ER = 0 GOTO 28300
  371. 28220  PRINT ER;" ERRORS DETECTED"
  372. 28230  PRINT D$;"CLOSE"
  373. 28240  PRINT D$;"DELETE STB.P1.TMP"
  374. 28250  PRINT D$;"DELETE STB.P2.TMP"
  375. 28260  END 
  376. 28300  PRINT D$;"WRITE STB.P2.TMP"
  377. 28310  PRINT "TEXT"
  378. 28315  PRINT "HOME"
  379. 28320  PRINT "PRINT"; CHR$(34);"PROGRAM IS NOW LOADED"; CHR$(34)
  380. 28400  PRINT "DELETE STB.P2.TMP"
  381. 28500  PRINT D$;"CLOSE STB.P1.TMP"
  382. 28600  PRINT D$;"CLOSE STB.P2.TMP"
  383. 28700  PRINT D$;"DELETE STB.P1.TMP"
  384. 28710  HOME : VTAB 10: HTAB 10: PRINT "LOADING"
  385. 28720  VTAB 23
  386. 28730  POKE 34,23
  387. 28800  PRINT D$;"EXEC STB.P2.TMP"
  388. 28900  END 
  389. 29000  REM 
  390. 29010 J = 1
  391. 29020  IF  MID$ (A$,J,1) < = "9"  THEN J = J +1: GOTO 29020
  392. 29030 SF$ =  MID$ (A$,J,2)
  393. 29050  IF SF$ < >"IF"  AND SF$ < >"GO"  AND SF$ < >"ON" GOTO 30300
  394. 29100 SF$ = "GOTO"
  395. 29200  GOSUB 24600
  396. 29300  IF LM >0  THEN GL = LM +4: GOTO 29710
  397. 29400 SF$ = "GOSUB"
  398. 29500  GOSUB 24600
  399. 29600  IF LM = 0 GOTO 30300
  400. 29700 GL = LM +5
  401. 29710  IF  MID$ (A$,J,2) = "ON"  AND  MID$ (A$,J,5) < >"ONERR" GOTO 30700
  402. 29800 GL$ =  RIGHT$(A$, LEN(A$) -GL +1)
  403. 29805  IF  LEFT$(GL$,1) > = "0"  AND  LEFT$(GL$,1) < = "9" GOTO 30300
  404. 29807 SF$ = GL$
  405. 29810  GOSUB 25500
  406. 29900  IF IZ =  -1 GOTO 30217
  407. 30100 A$ =  LEFT$(A$,GL -1) + STR$(IZ)
  408. 30210  GOTO 30300
  409. 30217  PRINT D$: FLASH 
  410. 30220  PRINT "----->";GL$;" UNDEFINED"
  411. 30225 ER = ER +1
  412. 30230  NORMAL 
  413. 30300  PRINT D$;"WRITE STB.P2.TMP"
  414. 30400  PRINT A$
  415. 30410 V =  VAL(A$)
  416. 30420  IF  INT(V/100) *100 = V  THEN  PRINT "X=PEEK(49385)"
  417. 30500  PRINT D$: PRINT A$
  418. 30600  GOTO 28000
  419. 30700  REM  ** PROCESS ON STATEMENT
  420. 30800 GL$ =  LEFT$(A$,GL -1)
  421. 31000 J = GL
  422. 31100  GOSUB 26210
  423. 31200 SF$ = LB$
  424. 31300  GOSUB 25700
  425. 31400  IF IZ > = 0 GOTO 31500
  426. 31410 ER = ER +1
  427. 31420  FLASH : PRINT SF$;" UNDEFINED"
  428. 31430  NORMAL 
  429. 31440  IF LL = 0 GOTO 31100
  430. 31450  GOTO 30300
  431. 31500 GL$ = GL$ + STR$(IZ)
  432. 31600  IF LL = 0  THEN GL$ = GL$ +",": GOTO 31100
  433. 31700 A$ = GL$
  434. 31800  GOTO 30300